library(Seurat)
library(princurve)
library(monocle)
library(Matrix)
library(dplyr)
library(RColorBrewer)
library(ggplot2)
library(ggExtra)
library(cowplot)
library(wesanderson)
#Set ggplot theme as classic
theme_set(theme_classic())Hem.data <- readRDS("../QC.filtered.cells.RDS")
Idents(Hem.data) <- Hem.data$Cell_identDimPlot(object = Hem.data,
group.by = "Cell_ident",
reduction = "spring",
cols = c("#83c3b8", #"ChP"
"#009fda", #"ChP_progenitors"
"#68b041", #"Dorso-Medial_pallium"
"#e46b6b", #"Hem"
"#e3c148", #"Medial_pallium"
"#b7d174", #2
"grey40", #4
"black", #5
"#3e69ac" #"Thalamic_eminence"
))Neurons.data <- subset(Hem.data, idents = c("seurat_clusters_2"))
DimPlot(Neurons.data ,
reduction = "spring",
pt.size = 1,
cols = c("#b7d174")) + NoAxes() ## Split Pallial from Cajal-Retzius cells
p1 <- FeaturePlot(object = Neurons.data ,
features = c("BP_signature1","LN_signature1"),
pt.size = 0.5,
cols = rev(brewer.pal(10,"Spectral")),
reduction = "spring",
order = T) & NoAxes()
p2 <- FeaturePlot(object = Neurons.data ,
features = c("Foxg1", "Trp73"),
pt.size = 0.5,
cols = c("grey90", brewer.pal(9,"YlGnBu")),
reduction = "spring",
order = T) & NoAxes()
p1 / p2 Separation between the 2 lineage seems straightforward. We use louvain clustering to split the two.
Neurons.data <- RunPCA(Neurons.data, verbose = FALSE)
Neurons.data <- FindNeighbors(Neurons.data,
dims = 1:10,
k.param = 8)
Neurons.data <- FindClusters(Neurons.data, resolution = 0.05)## Modularity Optimizer version 1.3.0 by Ludo Waltman and Nees Jan van Eck
##
## Number of nodes: 2835
## Number of edges: 56608
##
## Running Louvain algorithm...
## Maximum modularity in 10 random starts: 0.9640
## Number of communities: 2
## Elapsed time: 0 seconds
DimPlot(Neurons.data,
reduction = "spring",
cols = c("#cc391b","#026c9a"),
pt.size = 0.5) & NoAxes()Neurons.data$Lineage <- sapply(as.numeric(Neurons.data$SCT_snn_res.0.05),
FUN = function(x) {x= c("Hem","Pallial")[x]})DimPlot(object = Neurons.data,
group.by = "Lineage",
reduction = "spring",
cols = c("#cc391b","#026c9a"),
pt.size = 0.5) & NoAxes() ## Fit principale curve on the two lineages
Trajectories.Hem <- Neurons.data@meta.data %>%
select("Barcodes", "nUMI", "Spring_1", "Spring_2", "Lineage") %>%
filter(Lineage == "Hem")fit <- principal_curve(as.matrix(Trajectories.Hem[,c("Spring_1", "Spring_2")]),
smoother='lowess',
trace=TRUE,
f = .7,
stretch=0)## Starting curve---distance^2: 45804778678
## Iteration 1---distance^2: 27732113
## Iteration 2---distance^2: 27728318
#The principal curve smoothed
Hem.pc.line <- as.data.frame(fit$s[order(fit$lambda),])
#Pseudotime score
Trajectories.Hem$PseudotimeScore <- fit$lambda/max(fit$lambda)if (cor(Trajectories.Hem$PseudotimeScore, Neurons.data@assays$SCT@data['Hmga2', Trajectories.Hem$Barcodes]) > 0) {
Trajectories.Hem$PseudotimeScore <- -(Trajectories.Hem$PseudotimeScore - max(Trajectories.Hem$PseudotimeScore))
}Trajectories.Pallial <- Neurons.data@meta.data %>%
select("Barcodes", "nUMI", "Spring_1", "Spring_2", "Lineage") %>%
filter(Lineage == "Pallial")fit <- principal_curve(as.matrix(Trajectories.Pallial[,c("Spring_1", "Spring_2")]),
smoother='lowess',
trace=TRUE,
f = .7,
stretch=0)## Starting curve---distance^2: 26984853690
## Iteration 1---distance^2: 22153700
## Iteration 2---distance^2: 22179462
## Iteration 3---distance^2: 22180297
#The principal curve smoothed
Pallial.pc.line <- as.data.frame(fit$s[order(fit$lambda),])
#Pseudotime score
Trajectories.Pallial$PseudotimeScore <- fit$lambda/max(fit$lambda)if (cor(Trajectories.Pallial$PseudotimeScore, Neurons.data@assays$SCT@data['Hmga2', Trajectories.Pallial$Barcodes]) > 0) {
Trajectories.Pallial$PseudotimeScore <- -(Trajectories.Pallial$PseudotimeScore - max(Trajectories.Pallial$PseudotimeScore))
}Trajectories.neurons <- rbind(Trajectories.Pallial, Trajectories.Hem)cols <- brewer.pal(n =11, name = "Spectral")
ggplot(Trajectories.neurons, aes(Spring_1, Spring_2)) +
geom_point(aes(color=PseudotimeScore), size=2, shape=16) +
scale_color_gradientn(colours=rev(cols), name='Speudotime score') +
geom_line(data=Pallial.pc.line, color="#026c9a", size=0.77) +
geom_line(data=Hem.pc.line, color="#cc391b", size=0.77) ## Plot pan-neuronal genes along this axis
Neurons.data <- NormalizeData(Neurons.data, normalization.method = "LogNormalize", scale.factor = 10000, assay = "RNA")# Neurog2
p1 <- FeaturePlot(object = Neurons.data,
features = c("Neurog2"),
pt.size = 0.5,
cols = c("grey90", brewer.pal(9,"YlGnBu")),
reduction = "spring",
order = T) & NoAxes()
Trajectories.neurons$Neurog2 <- Neurons.data@assays$RNA@data["Neurog2", Trajectories.neurons$Barcodes]
p2 <- ggplot(Trajectories.neurons, aes(x= PseudotimeScore, y= Neurog2)) +
geom_point(aes(color= Lineage), size=0.5) +
scale_color_manual(values= c("#cc391b", "#026c9a")) +
geom_smooth(method="loess", n= 50, aes(color= Lineage)) +
ylim(0,NA)
# Tbr1
p3 <- FeaturePlot(object = Neurons.data ,
features = c("Tbr1"),
pt.size = 0.5,
cols = c("grey90", brewer.pal(9,"YlGnBu")),
reduction = "spring",
order = T) & NoAxes()
Trajectories.neurons$Tbr1 <- Neurons.data@assays$RNA@data["Tbr1", Trajectories.neurons$Barcodes]
p4 <- ggplot(Trajectories.neurons, aes(x= PseudotimeScore, y= Tbr1)) +
geom_point(aes(color= Lineage), size=0.5) +
scale_color_manual(values= c("#cc391b", "#026c9a")) +
geom_smooth(method="loess", n= 50, aes(color= Lineage)) +
ylim(0,NA)
# Mapt
p5 <- FeaturePlot(object = Neurons.data ,
features = c("Mapt"),
pt.size = 0.5,
cols = c("grey90", brewer.pal(9,"YlGnBu")),
reduction = "spring",
order = T) & NoAxes()
Trajectories.neurons$Mapt <- Neurons.data@assays$RNA@data["Mapt", Trajectories.neurons$Barcodes]
p6 <- ggplot(Trajectories.neurons, aes(x= PseudotimeScore, y= Mapt)) +
geom_point(aes(color= Lineage), size=0.5) +
scale_color_manual(values= c("#cc391b", "#026c9a")) +
geom_smooth(method="loess", n= 50, aes(color= Lineage)) +
ylim(0,NA)
p1 + p2 + p3 + p4 + p5 + p6 + patchwork::plot_layout(ncol = 2)Since we observe the first 25% of both trajectories are occupied by few, likely progenitor cells, we shift this cell along the axis
Pseudotime.intervals <- Trajectories.neurons%>%
select(Lineage, PseudotimeScore) %>%
mutate(Pseudotime.bins = cut(Trajectories.neurons$PseudotimeScore, seq(0, max(Trajectories.neurons$PseudotimeScore) + 0.05, 0.05), dig.lab = 2, right = FALSE)) %>%
group_by(Lineage, Pseudotime.bins) %>%
summarise(n=n())
ggplot(Pseudotime.intervals, aes(x=Pseudotime.bins, y=n, fill=Lineage)) +
geom_bar(stat = "identity", width = 0.90) +
theme(axis.text.x = element_text(angle = 45, hjust=1))+
scale_fill_manual(values= c("#cc391b", "#026c9a"))score <- sapply(Trajectories.neurons$PseudotimeScore,
FUN = function(x) if (x <= 0.2) {x= 0.2} else { x=x })
Trajectories.neurons$PseudotimeScore.shifted <- (score - min(score)) / (max(score) - min(score))# Neurog2
p1 <- FeaturePlot(object = Neurons.data ,
features = c("Neurog2"),
pt.size = 0.5,
cols = c("grey90", brewer.pal(9,"YlGnBu")),
reduction = "spring",
order = T) & NoAxes()
p2 <- ggplot(Trajectories.neurons, aes(x= PseudotimeScore.shifted, y= Neurog2)) +
geom_point(aes(color= Lineage), size=0.5) +
scale_color_manual(values= c("#cc391b", "#026c9a")) +
geom_smooth(method="loess", n= 50, aes(color= Lineage)) +
ylim(0,NA)
# Tbr1
p3 <- FeaturePlot(object = Neurons.data ,
features = c("Tbr1"),
pt.size = 0.5,
cols = c("grey90", brewer.pal(9,"YlGnBu")),
reduction = "spring",
order = T) & NoAxes()
p4 <- ggplot(Trajectories.neurons, aes(x= PseudotimeScore.shifted, y= Tbr1)) +
geom_point(aes(color= Lineage), size=0.5) +
scale_color_manual(values= c("#cc391b", "#026c9a")) +
geom_smooth(method="loess", n= 50, aes(color= Lineage)) +
ylim(0,NA)
# Mapt
p5 <- FeaturePlot(object = Neurons.data ,
features = c("Mapt"),
pt.size = 0.5,
cols = c("grey90", brewer.pal(9,"YlGnBu")),
reduction = "spring",
order = T) & NoAxes()
p6 <- ggplot(Trajectories.neurons, aes(x= PseudotimeScore.shifted, y= Mapt)) +
geom_point(aes(color= Lineage), size=0.5) +
scale_color_manual(values= c("#cc391b", "#026c9a")) +
geom_smooth(method="loess", n= 50, aes(color= Lineage)) +
ylim(0,NA)
p1 + p2 + p3 + p4 + p5 + p6 + patchwork::plot_layout(ncol = 2)ggplot(Trajectories.neurons, aes(x= PseudotimeScore.shifted, y= nUMI/10000)) +
geom_point(aes(color= Lineage), size=0.5) +
scale_color_manual(values= c("#cc391b", "#026c9a")) +
geom_smooth(method="loess", n= 50, aes(color= Lineage)) +
ylim(0,NA)rm(list = ls()[!ls() %in% c("Trajectories.neurons")])Progenitors.data <- readRDS("../ProgenitorsDiversity/Progenitors.RDS")table(Progenitors.data$Cell_ident)##
## Dorso-Medial_pallium Hem Medial_pallium
## 3451 1954 2719
To balance the number of progenitors in both domain we will only work with Hem and Medial_pallium annotated cells. Since we are using pallial cell to contrast CR specific trajectory we think this approximation will not significantly affect our analysis.
Progenitors.data <- subset(Progenitors.data, idents = c("Hem", "Medial_pallium"))p1 <- DimPlot(Progenitors.data,
reduction = "spring",
pt.size = 0.5,
cols = c("#e3c148", "#e46b6b")) + NoAxes()
p2 <- FeaturePlot(object = Progenitors.data,
features = "Angle.cc",
pt.size = 0.5,
cols = rev(colorRampPalette(brewer.pal(n =10, name = "Spectral"))(100)),
reduction = "spring",
order = T) & NoAxes()
p3 <- DimPlot(object = Progenitors.data,
group.by = "Revelio.phase",
pt.size = 0.5,
reduction = "spring",
cols = c(wes_palette("FantasticFox1")[1:3],"grey40",wes_palette("FantasticFox1")[5])) & NoAxes()
p1 + p2 + p3 + patchwork::plot_layout(ncol = 2)# Start with neurons data
Trajectories.all <- Trajectories.neurons %>% select(Barcodes, nUMI, Spring_1, Spring_2, Lineage)
Trajectories.all$Pseudotime <- Trajectories.neurons$PseudotimeScore.shifted + 1
Trajectories.all$Phase <- NA# Add progenitors data
Trajectories.progenitors <- Progenitors.data@meta.data %>%
select(Barcodes, nUMI, Spring_1, Spring_2) %>%
mutate(Lineage= ifelse(Progenitors.data$Cell_ident == "Medial_pallium", "Pallial", "Hem") ,
Pseudotime= Progenitors.data$Angle.cc,
Phase = Progenitors.data$Revelio.phase)Trajectories.all <- rbind(Trajectories.all, Trajectories.progenitors)
Trajectories.all$Phase <- factor(Trajectories.all$Phase, levels = c("G1.S", "S", "G2", "G2.M", "M.G1"))p1 <- ggplot(Trajectories.all, aes(Spring_1, Spring_2)) +
geom_point(aes(color=Pseudotime), size=0.5) +
scale_color_gradientn(colours=rev(brewer.pal(n =11, name = "Spectral")), name='Speudotime score')
p2 <- ggplot(Trajectories.all, aes(Spring_1, Spring_2)) +
geom_point(aes(color= Lineage), size=0.5) +
scale_color_manual(values= c("#cc391b", "#026c9a"))
p1 + p2p1 <- ggplot(Trajectories.all, aes(x= Pseudotime, y= nUMI/10000)) +
geom_point(aes(color= Phase), size=0.5) +
scale_color_manual(values= c(wes_palette("FantasticFox1")[1:3],"grey40",wes_palette("FantasticFox1")[5])) +
geom_smooth(method="loess", n= 50, fill="grey") +
ylim(0,NA)
p2 <- ggplot(Trajectories.all, aes(x= Pseudotime, y= nUMI/10000)) +
geom_point(aes(color= Lineage), size=0.5) +
scale_color_manual(values= c("#cc391b", "#026c9a")) +
geom_smooth(method="loess", n= 50, fill="grey") +
ylim(0,NA)
p1 + p2rm(list = ls()[!ls() %in% c("Trajectories.all")])Hem.data <- readRDS("../QC.filtered.cells.RDS")Neuro.trajectories <- CreateSeuratObject(counts = Hem.data@assays$RNA@data[, Trajectories.all$Barcodes],
meta.data = Trajectories.all)
spring <- as.matrix(Neuro.trajectories@meta.data %>% select("Spring_1", "Spring_2"))
Neuro.trajectories[["spring"]] <- CreateDimReducObject(embeddings = spring, key = "Spring_", assay = DefaultAssay(Neuro.trajectories))p1 <- FeaturePlot(object = Neuro.trajectories,
features = "Pseudotime",
pt.size = 1,
cols = rev(colorRampPalette(brewer.pal(n =11, name = "Spectral"))(100)),
reduction = "spring",
order = T) & NoAxes()
p2 <- DimPlot(object = Neuro.trajectories,
group.by = "Lineage",
pt.size = 1,
reduction = "spring",
cols = c("#cc391b", "#026c9a")) & NoAxes()
p3 <- DimPlot(object = Neuro.trajectories,
group.by = "Phase",
pt.size = 1,
reduction = "spring",
cols = c(wes_palette("FantasticFox1")[1:3],"grey40",wes_palette("FantasticFox1")[5])) & NoAxes()
p1 + p2 + p3rm(list = ls()[!ls() %in% c("Neuro.trajectories")])Neuro.trajectories<- NormalizeData(Neuro.trajectories, normalization.method = "LogNormalize", scale.factor = 10000, assay = "RNA")Neuro.trajectories <- FindVariableFeatures(Neuro.trajectories, selection.method = "vst", nfeatures = 2000, assay = "RNA")trend <- function(Seurat.data,
group.by,
gene){
data <- Seurat.data@meta.data %>% select(Lineage, Pseudotime, Phase)
data$Gene <- Seurat.data@assays$RNA@data[gene,]
if (!group.by == "Lineage") {
p <- ggplot(data=data, aes(x= Pseudotime, y= Gene)) +
geom_point(aes(color= Phase), size=0.5) +
scale_color_manual(values= c(wes_palette("FantasticFox1")[1:3],"grey40",wes_palette("FantasticFox1")[5])) +
geom_smooth(method="loess", n= 50, fill="grey") +
ylim(0,NA) +
ggtitle(gene)
} else {
p <- ggplot(data=data, aes(x= Pseudotime, y= Gene)) +
geom_point(aes(color= Lineage), size=0.5) +
scale_color_manual(values= c("#cc391b", "#026c9a")) +
geom_smooth(method="loess", n= 50, aes(color= Lineage)) +
ylim(0,NA) +
ggtitle(gene)
}
return(p)
}
Plot.Genes.trend <- function(Seurat.data,
group.by,
genes){
pList <- mapply(FUN = trend, gene = genes,
MoreArgs = list(Seurat.data = Seurat.data, group.by=group.by),
SIMPLIFY = FALSE)
print(x = cowplot::plot_grid(plotlist = pList, ncol = 2))
} Plot.Genes.trend(Seurat.data= Neuro.trajectories,
group.by = "Lineage",
genes= c("Gas1","Sox2",
"Neurog2", "Btg2",
"Tbr1", "Mapt",
"Trp73", "Foxg1"))Plot.Genes.trend(Seurat.data= Neuro.trajectories,
group.by = "Lineage",
genes= c("Gmnc", "Mcidas",
"Foxj1", "Trp73",
"Lhx1", "Cdkn1a"))Plot.Genes.trend(Seurat.data= Neuro.trajectories,
group.by = "Lineage",
genes= c("Mki67", "Top2a",
"H2afx", "Cdkn1c"))#date
format(Sys.time(), "%d %B, %Y, %H,%M")## [1] "06 décembre, 2021, 17,57"
#Packages used
sessionInfo()## R version 4.1.2 (2021-11-01)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.3 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
##
## locale:
## [1] LC_CTYPE=fr_FR.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=fr_FR.UTF-8 LC_COLLATE=fr_FR.UTF-8
## [5] LC_MONETARY=fr_FR.UTF-8 LC_MESSAGES=fr_FR.UTF-8
## [7] LC_PAPER=fr_FR.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=fr_FR.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] splines stats4 stats graphics grDevices utils datasets
## [8] methods base
##
## other attached packages:
## [1] wesanderson_0.3.6 cowplot_1.1.1 ggExtra_0.9
## [4] RColorBrewer_1.1-2 dplyr_1.0.7 monocle_2.22.0
## [7] DDRTree_0.1.5 irlba_2.3.3 VGAM_1.1-5
## [10] ggplot2_3.3.5 Biobase_2.54.0 BiocGenerics_0.40.0
## [13] Matrix_1.3-4 princurve_2.1.6 SeuratObject_4.0.4
## [16] Seurat_4.0.5
##
## loaded via a namespace (and not attached):
## [1] Rtsne_0.15 colorspace_2.0-2 deldir_1.0-6
## [4] ellipsis_0.3.2 ggridges_0.5.3 spatstat.data_2.1-0
## [7] farver_2.1.0 leiden_0.3.9 listenv_0.8.0
## [10] ggrepel_0.9.1 fansi_0.5.0 codetools_0.2-18
## [13] docopt_0.7.1 knitr_1.36 polyclip_1.10-0
## [16] jsonlite_1.7.2 ica_1.0-2 cluster_2.1.2
## [19] png_0.1-7 pheatmap_1.0.12 uwot_0.1.10
## [22] shiny_1.7.1 sctransform_0.3.2 spatstat.sparse_2.0-0
## [25] compiler_4.1.2 httr_1.4.2 assertthat_0.2.1
## [28] fastmap_1.1.0 lazyeval_0.2.2 limma_3.50.0
## [31] later_1.3.0 htmltools_0.5.2 tools_4.1.2
## [34] igraph_1.2.9 gtable_0.3.0 glue_1.5.1
## [37] RANN_2.6.1 reshape2_1.4.4 Rcpp_1.0.7
## [40] slam_0.1-49 scattermore_0.7 jquerylib_0.1.4
## [43] vctrs_0.3.8 nlme_3.1-153 lmtest_0.9-39
## [46] xfun_0.28 stringr_1.4.0 globals_0.14.0
## [49] mime_0.12 miniUI_0.1.1.1 lifecycle_1.0.1
## [52] goftest_1.2-3 future_1.23.0 MASS_7.3-54
## [55] zoo_1.8-9 scales_1.1.1 spatstat.core_2.3-1
## [58] promises_1.2.0.1 spatstat.utils_2.2-0 parallel_4.1.2
## [61] yaml_2.2.1 reticulate_1.22 pbapply_1.5-0
## [64] gridExtra_2.3 sass_0.4.0 rpart_4.1-15
## [67] fastICA_1.2-3 stringi_1.7.6 highr_0.9
## [70] densityClust_0.3 rlang_0.4.12 pkgconfig_2.0.3
## [73] matrixStats_0.61.0 qlcMatrix_0.9.7 evaluate_0.14
## [76] lattice_0.20-45 ROCR_1.0-11 purrr_0.3.4
## [79] tensor_1.5 labeling_0.4.2 patchwork_1.1.1
## [82] htmlwidgets_1.5.4 tidyselect_1.1.1 parallelly_1.29.0
## [85] RcppAnnoy_0.0.19 plyr_1.8.6 magrittr_2.0.1
## [88] R6_2.5.1 generics_0.1.1 combinat_0.0-8
## [91] DBI_1.1.1 pillar_1.6.4 withr_2.4.3
## [94] mgcv_1.8-38 fitdistrplus_1.1-6 survival_3.2-13
## [97] abind_1.4-5 tibble_3.1.6 future.apply_1.8.1
## [100] crayon_1.4.2 KernSmooth_2.23-20 utf8_1.2.2
## [103] spatstat.geom_2.3-0 plotly_4.10.0 rmarkdown_2.11
## [106] viridis_0.6.2 grid_4.1.2 data.table_1.14.2
## [109] FNN_1.1.3 sparsesvd_0.2 HSMMSingleCell_1.14.0
## [112] digest_0.6.29 xtable_1.8-4 tidyr_1.1.4
## [115] httpuv_1.6.3 munsell_0.5.0 viridisLite_0.4.0
## [118] bslib_0.3.1
Institute of Psychiatry and Neuroscience of Paris, INSERM U1266, 75014, Paris, France, matthieu.moreau@inserm.fr↩︎